home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / wb1a1.lha / wb / stats.scm < prev    next >
Encoding:
Text File  |  1993-06-29  |  5.9 KB  |  170 lines
  1. ; Wb-tree File Based Associative String Data Base System.
  2. ; Copyright (c) 1991, 1992, 1993 Holland Mark Martin
  3. ;
  4. ;Permission to use, copy, modify, and distribute this software and its
  5. ;documentation for educational, research, and non-profit purposes and
  6. ;without fee is hereby granted, provided that the above copyright
  7. ;notice appear in all copies and that both that copyright notice and
  8. ;this permission notice appear in supporting documentation, and that
  9. ;the name of Holland Mark Martin not be used in advertising or
  10. ;publicity pertaining to distribution of the software without specific,
  11. ;written prior consent in each case.  Permission to incorporate this
  12. ;software into commercial products can be obtained from Jonathan
  13. ;Finger, Holland Mark Martin, 174 Middlesex Turnpike, Burlington, MA,
  14. ;01803-4467, USA.  Holland Mark Martin makes no representations about
  15. ;the suitability or correctness of this software for any purpose.  It
  16. ;is provided "as is" without express or implied warranty.  Holland Mark
  17. ;Martin is under no obligation to provide any services, by way of
  18. ;maintenance, update, or otherwise.
  19.  
  20. (require (in-vicinity (program-vicinity) "sys"))
  21.  
  22. ;;; PERFORMANCE STATISTICS
  23.  
  24. (define next-ct #f)
  25. (define next-fct #f)
  26. (define prev-ct #f)
  27. (define prev-fct #f)
  28. (define get-ct #f)
  29. (define get-fct #f)
  30. (define put-ct #f)
  31. (define put-fct #f)
  32. (define rem-ct #f)
  33. (define rem-fct #f)
  34. (define ge-ct #f)
  35. (define ge-fct #f)
  36. (define tge-ct #f)
  37. (define tge-fct #f)
  38. (define tce-ct #f)
  39. (define tce-fct #f)
  40.  
  41. (define chains-to-next #f)        ; counters for special-case occurrences
  42. (define deferred-inserts #f)
  43. (define split-index-inserts #f)
  44. (define index-screw-case  #f)
  45. (define block-splits #f)
  46. (define block-deletes #f)
  47. (define deferred-deletes #f)
  48. (define dir-dty-ct #f)
  49.  
  50. (define read-ct #f)            ; buffer i/o counters
  51. (define write-ct #f)
  52. (define read-fl-ct #f)
  53. (define write-fl-ct #f)
  54. (define flush-ct #f)
  55.  
  56. (define (clear-stats)
  57.   (set! next-ct 0)
  58.   (set! next-fct 0)
  59.   (set! prev-ct 0)
  60.   (set! prev-fct 0)
  61.   (set! get-ct 0)
  62.   (set! get-fct 0)
  63.   (set! put-ct 0)
  64.   (set! put-fct 0)
  65.   (set! rem-ct 0)
  66.   (set! rem-fct 0)
  67.   (set! ge-ct 0)
  68.   (set! ge-fct 0)
  69.   (set! tge-ct 0)
  70.   (set! tge-fct 0)
  71.   (set! tce-ct 0)
  72.   (set! tce-fct 0)
  73.  
  74.   (set! chains-to-next 0)
  75.   (set! deferred-inserts 0)
  76.   (set! split-index-inserts 0)
  77.   (set! index-screw-case  0)
  78.   (set! block-splits 0)
  79.   (set! block-deletes 0)
  80.   (set! deferred-deletes 0)
  81.   (set! dir-dty-ct 0)
  82.  
  83.   (set! read-ct 0)
  84.   (set! write-ct 0)
  85.   (set! read-fl-ct 0)
  86.   (set! write-fl-ct 0)
  87.   (set! flush-ct 0)
  88.   SUCCESS)
  89.  
  90. (define (cstats)
  91.   (stats)
  92.   (clear-stats))
  93.  
  94. (define (stats)
  95.   (fprintf diagout "\\n" )
  96.   (fprintf diagout "OPERATIONS SUMMARY:\\n" )
  97.   (fprintf diagout
  98.        "            NEXT     PREV      GET      PUT      REM   GETENT   CACHE    CACHE\\n")
  99.   (fprintf diagout
  100.        "                                                                AVAIL?   VALID?\\n")
  101.   (fprintf diagout "   succ %8lu %8lu %8lu %8lu %8lu %8lu %8lu %8lu\\n"
  102.        next-ct prev-ct get-ct put-ct rem-ct ge-ct tge-ct tce-ct)
  103.   (fprintf diagout "   fail %8lu %8lu %8lu %8lu %8lu %8lu %8lu %8lu\\n\\n"
  104.        next-fct prev-fct get-fct put-fct rem-fct ge-fct tge-fct tce-fct)
  105.  
  106.   (fprintf diagout "INTERNAL OPERATIONS SUMMARY:\\n" )
  107.   (fprintf diagout "   chains-to-next = %d\\n" chains-to-next)
  108.   (fprintf diagout "   %d block splits, %d deferred parent updates, %d undone\\n"
  109.        block-splits deferred-inserts  deferred-inserts)
  110.   (fprintf diagout "   %d split index inserts; %d index-insert screw cases \\n"
  111.        split-index-inserts index-screw-case )
  112.   (fprintf diagout "   %d block deletes; %d deferred block deletes\\n\\n"
  113.        block-deletes deferred-deletes)
  114.   
  115.   (fprintf diagout "I/O SUMMARY: %lu READS, %lu WRITES, %lu FLUSH (of dirty bufs) calls.\\n"
  116.        read-ct write-ct flush-ct)
  117.   (fprintf diagout "             %lu FREELIST READS, %lu FREELIST WRITES.\\n"
  118.        read-fl-ct write-fl-ct)
  119.   (fprintf diagout "             %lu DIRS LEFT DTY.\\n"
  120.        dir-dty-ct)
  121.   (let ((ops (max (+ next-fct prev-fct get-fct put-fct rem-fct
  122.          next-ct prev-ct get-ct put-ct rem-ct ) 1)))
  123.     (fprintf diagout "   AVG BLKS REFERENCED PER OPERATION: %7d%%\\n"
  124.        (quotient (* 100 (+ ge-ct tce-ct)) ops))
  125.     (fprintf diagout "   AVG DISK I/Os PER OPERATION: %7d%%; "
  126.          (quotient (* 100 (+ read-ct write-ct read-fl-ct write-fl-ct)) ops))
  127.     (fprintf diagout "   WRITE/READ RATIO: %7d%%\\n"
  128.          (quotient (* 100 (+ write-ct write-fl-ct)) (max 1 (+  read-ct read-fl-ct))))
  129.     (if (> put-ct 0)
  130.     (fprintf diagout "   AVG DISK WRITES PER PUT: %7d%%\\n"
  131.          (quotient (* 100 write-ct) put-ct)))
  132.     )
  133.   (fprintf diagout "\\n" )
  134.   (fprintf diagout "MODES IN EFFECT:\\n" )
  135.   (fprintf diagout "%d buffers [hashed over %d buckets]; blksize (max)=%d; FLC-LEN=%d\\n"
  136.        num-ents-ct NUM-BUKS blk-size FLC-LEN)
  137.   (fprintf diagout "defer-insert-updates= %2s; defer-block-deletes=%2s\\n"
  138.        (if defer-insert-updates "#t" "#f") (if defer-block-deletes "#t" "#f") )
  139.   (fprintf diagout "cache-ent-enable=%2s; clever-cache-enable=%2s\\n"
  140.        (if cache-ent-enable "#t" "#f") (if clever-cache-enable "#t" "#f") )
  141.   (fprintf diagout "\\n" )
  142.   SUCCESS)
  143.  
  144. (define (show-buffer! ent)
  145.   (fprintf stderr "SEG = %d ID= %lu ACC= %d REF= %d DTY= %d AGE= %d\\n"
  146.        (ENT-SEG ent)(ENT-ID ent)(ENT-ACC ent)(ENT-REF ent)(ENT-DTY? ent)(ENT-AGE ent)))
  147.  
  148. (define buf-verbose #t)
  149.  
  150. (define (show-buffer-1 ent)
  151.   (cond ((or buf-verbose (> (ENT-SEG ent) -1))
  152.      (fprintf stderr " %3d:%-6d %6lu %8d %6lu %7d %3d %4d"
  153.           (ENT-SEG ent) (ENT-ID ent) (HASH2INT (ENT-SEG ent) (ENT-ID ent)) (ENT-ACC ent)
  154.           (ENT-REF ent) 0 (ENT-DTY? ent) (ENT-AGE ent))
  155.      (if (> (ENT-SEG ent) -1)
  156.          (fprintf stderr " %5d %4c\\n"
  157.               (- (BLK-LEVEL (ENT-BLK ent)) LEAF)
  158.               (BLK-TYP (ENT-BLK ent)))
  159.          (fprintf stderr "\\n"))
  160.      ))
  161.   SUCCESS)
  162.  
  163. (define (show-buffers)
  164.   (fprintf diagout "\\n" )
  165.   (fprintf diagout
  166.        " SEG:ID        BUK      ACC    REF READERS DTY  AGE LEVEL TYPE\\n")
  167.   (do-seg-buffers -1 show-buffer-1))
  168.  
  169. (define (sb) (show-buffers))
  170.